home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / tmodem23.arc / RWINDOW.INC < prev    next >
Encoding:
Text File  |  1985-05-19  |  5.0 KB  |  165 lines
  1. (****************************************************************************)
  2. (*                          REMOVABLE WINDOWS                               *)
  3. (*                                                                          *)
  4. (*              Call INITWIN before calling  MKWIN or RMWIN.                *)
  5. (*                                                                          *)
  6. (*              Uses some routines from the BASIC.INC Package.              *)
  7. (****************************************************************************)
  8.  
  9. const
  10.    maxwin    = 30;                { Adjustable !!! }
  11.  
  12. type
  13.    labeltype  = string[60];
  14.    imagetype  = array[1..3840] of char;
  15.    windimtype = record
  16.                    x1,y1,x2,y2  : byte;
  17.                 end;
  18. var
  19.    win         : record
  20.                     xh,yh : byte;
  21.                     dim   : windimtype;
  22.                     depth : integer;
  23.                     stack : array[1..maxwin] of
  24.                                record
  25.                                   images   : ^imagetype;
  26.                                   dim      : windimtype;
  27.                                   x,y      : integer;
  28.                                end;
  29.                  end;
  30.    crtmode     : byte      absolute $0040:$0049;
  31.    monobuffer  : imagetype absolute $B000:$0000;
  32.    colorbuffer : imagetype absolute $B800:$0000;
  33.  
  34. (****************************************************************************)
  35. (*                          Initial Window System                           *)
  36. (****************************************************************************)
  37. procedure
  38.    initwin;
  39. begin
  40.    with win.dim do begin
  41.       x1 := 1;
  42.       y1 := 1;
  43.       x2 := 80;
  44.       y2 := 24;
  45.    end;
  46.    win.depth := 0;
  47. end;
  48.  
  49. (****************************************************************************)
  50. (*                           DRAW BOX FOR WINDOW                            *)
  51. (****************************************************************************)
  52. procedure
  53.    boxwin(x1,y1,x2,y2 : integer; winlabel : labeltype);
  54. var
  55.    x,y       : integer;
  56. begin
  57.    window(x1,y1,x2,y2);
  58.    clrscr;
  59.    window(1,1,80,25);
  60.    textcolor( lightgray );
  61.    textbackground( black );
  62.  
  63.    { TOP }
  64.    gotoxy(x1,y1);
  65.    write(#201+bstring(x2-x1-1,#205)+#187);
  66.  
  67.    { SIDES }
  68.    for y := y1+1 to y2-1 do begin
  69.       gotoxy(x1,y);
  70.       write(#186);
  71.       gotoxy(x2,y);
  72.       write(#186);
  73.    end;
  74.  
  75.    { BOTTOM }
  76.    gotoxy(x1,y2);
  77.    write(#200+bstring(x2-x1-1,#205)+#188);
  78.  
  79.    if length(winlabel)>0 then begin
  80.       gotoxy(x1+5,y1);
  81.       write(#175+'  ',winlabel,'  '+#174);
  82.    end;
  83.    textcolor( FGcolor );
  84.    textbackground( BGcolor );
  85.    window(x1+1,y1+1,x2-1,y2-1);
  86.    gotoxy(1,1);
  87. end;
  88.  
  89. (****************************************************************************)
  90. (*                               MAKE A WINDOW                              *)
  91. (****************************************************************************)
  92. procedure
  93.    mkwin(x1,y1,x2,y2 : integer; winlabel : labeltype);
  94. begin
  95.    with win do depth := depth+1;
  96.    if (win.depth > maxwin) or (memory < 6) then begin
  97.       writeln;
  98.       window(1,1,80,25);
  99.       gotoxy(1,25);
  100.       clreol;
  101.       writeln(^G^G,' Out of Memory!!! ');
  102.       halt;
  103.    end;
  104.  
  105.    new(win.stack[win.depth].images);
  106.    if crtmode = 7 then
  107.       win.stack[win.depth].images^ := monobuffer
  108.    else
  109.       win.stack[win.depth].images^ := colorbuffer;
  110.  
  111.    win.stack[win.depth].dim := win.dim;
  112.    win.stack[win.depth].x   := wherex;
  113.    win.stack[win.depth].y   := wherey;
  114.  
  115.    boxwin(x1,y1,x2,y2,winlabel);
  116.    win.dim.x1 := x1+1;
  117.    win.dim.y1 := y1+1;
  118.  
  119.    win.dim.x2 := x2-1;
  120.    win.dim.y2 := y2-1;
  121. end;
  122.  
  123. (****************************************************************************)
  124. (*                       REMOVE THE PREVIOUS WINDOW                         *)
  125. (****************************************************************************)
  126. procedure
  127.    rmwin;
  128. begin
  129.    if crtmode = 7 then
  130.       monobuffer := win.stack[win.depth].images^
  131.    else
  132.       colorbuffer := win.stack[win.depth].images^;
  133.    dispose(win.stack[win.depth].images);
  134.    with win do begin
  135.       dim := stack[depth].dim;
  136.       window(dim.x1,dim.y1,dim.x2,dim.y2);
  137.       gotoxy(stack[depth].x,stack[depth].y);
  138.       depth := depth-1;
  139.    end;
  140. end;
  141.  
  142. (****************************************************************************)
  143. (*                           ESCAPE FROM WINDOW                             *)
  144. (****************************************************************************)
  145. procedure
  146.    escape_win;
  147. begin
  148.    with win do begin
  149.       xh:=wherex;
  150.       yh:=wherey;
  151.       window(1,1,80,25);
  152.    end;
  153. end;
  154.  
  155. (****************************************************************************)
  156. (*                 REENTER WINDOW PREVIOUSLY ESCAPED FROM                   *)
  157. (****************************************************************************)
  158. procedure
  159.    reset_win;
  160. begin
  161.    with win do begin
  162.       window(dim.x1,dim.y1,dim.x2,dim.y2);
  163.       gotoxy(xh,yh);
  164.    end;
  165. end;